home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pct3661.arc / PCT366.MRG < prev    next >
Encoding:
Text File  |  1986-04-25  |  28.9 KB  |  555 lines
  1. 1  ' $TITLE: 'Revised PC-TALK 3, Ver 3.66, Level 840715, 7/15/84' $SUBTITLE:         'Compile /O/E/S/C:4096.LINK:.OBJ's IBMCOM+CHDIR+GETDIR+DSK' $PAGESIZE: 63       $LINESIZE: 97
  2. 2  ' by Jim Gainsley, Mpls MN 55401 (612)338-6124 (CIS: 70346,457), which incl.      work of other authors. (See the .DOC file for this ver & level.)
  3. 3  ' WARNING! PROGRAM MUST BE COMPILED WITH .OBJ's IN LINE 1. YOU MUST HAVE DOS      2.0 & 128k OF RAM.
  4. 4  '
  5. 5  '
  6. 6  '  TO BE MERGED ONLY WITH DISTRIBUTION VERSION PC-TALK3, LEVEL 830424
  7. 7  ' The Headlands Press, Inc.
  8. 8  ' P.O. Box 862
  9. 9  ' Tiburon, CA 94920
  10. 10 '
  11. 11 ' *  A limited license is granted to all users of this program,  *
  12. 12 ' *  to make copies of this program and distribute them to other *
  13. 13 ' *  users, on the following conditions:                         *
  14. 14 ' *     1. The notices contained in lines 1 through 100 of the   *
  15. 15 ' *        program are not to be altered, bypassed, or removed.  *
  16. 16 ' *     2. The program is not to be distributed to others in     *
  17. 17 ' *        modified form.                                        *
  18. 18 ' *     3. No fee is to be charged (or any other consideration   *
  19. 19 ' *        received) for copying or distributing the program     *
  20. 20 ' *        without an express written agreement with             *
  21. 21 ' *        The Headlands Press, Inc., Box 862, Tiburon, CA 94920 *
  22. 22 ' *                                                              *
  23. 23 ' *                 Copyright (c) 1983 The Headlands Press, Inc. *
  24. 24 '
  25. 25 '
  26. 26 '
  27. 27 '
  28. 50 CLEAR:SCREEN 0,1,0:WIDTH 80:CLS:KEY OFF:LOCATE ,,0
  29. 52 PRINT TAB(28)"tm":PRINT TAB(8);STRING$(4,205)" F R E E W A R E ";               STRING$(4,205)
  30. 54 PRINT TAB(9)"User-Supported Software":PRINT:PRINT CHR$(214)STRING$(36,196);     CHR$(183)
  31. 56 FOR I=1 TO 17:READ A$:PRINT CHR$(186);A$;SPACE$(36-LEN(A$));CHR$(186):NEXT
  32. 58 PRINT CHR$(211)STRING$(36,196)CHR$(189):PRINT"  (C) 1983, The Headlands Press, Inc.";:LOCATE 1,1
  33. 60 DATA"   If you use this program and find
  34. 62 DATA"   it of value, your contribution
  35. 64 DATA"   ($35.00 suggested) would be
  36. 66 DATA"   appreciated . . .
  37. 68 DATA"
  38. 70 DATA"         === Freeware ===
  39. 72 DATA"           P.O. Box 682
  40. 74 DATA"         Tiburon, CA 94920
  41. 76 DATA"
  42. 78 DATA"   You are encouraged to copy and
  43. 80 DATA"   share this program with other
  44. 82 DATA"   users, on the conditions that
  45. 84 DATA"   the program is not distributed
  46. 86 DATA"   in modified form, that no fee
  47. 88 DATA"   or consideration is charged,
  48. 90 DATA"   and that this notice is not
  49. 92 DATA"   bypassed or removed.
  50. 99 '
  51. 100 '   *****  INITIALIZE VARIABLES  *****
  52. 105 '
  53. 120 FLN!=0:CNT!=0:SD=32767:FS$=CHR$(124):FKFLG=0:FCC=1:FK$="":FEX=0:FFF=0:FP$=""    :FCR$="":SP=0:CLIN$=STRING$(79,32):TMP$="":B2$=""
  54. 199 '
  55. 200 '   *****  GET DEFAULTS  *****
  56. 201 '
  57. 210 DFNUM=30:DIM DP$(30):DIM D$(30):DIM DT$(30)
  58. 230 '
  59. 250 '
  60. 300 '   *****  START-UP  *****
  61. 305 '
  62. 310 '
  63. 315 '
  64. 320 COLOR FG,BG,BG:LOCATE 1,39:COLOR BG,FG:PRINT SPACE$(5);                         "MAKE SURE THAT YOUR MODEM IS ON"SPACE$(4):COLOR FG,BG:PRINT:RESTORE 355
  65. 325 LOCATE 3,39:PRINT CHR$(213);STRING$(38,205);CHR$(184)
  66. 330 FOR I=1 TO 6:READ A$:LOCATE ,39:PRINT VL$;A$;SPACE$(38-LEN(A$));VL$:NEXT
  67. 335 LOCATE ,39:PRINT CHR$(195);STRING$(38,196);CHR$(180)
  68. 340 FOR I=1 TO 12:READ A$:LOCATE ,39:PRINT VL$;A$;SPACE$(38-LEN(A$));VL$:NEXT
  69. 345 LOCATE ,39:PRINT CHR$(212);STRING$(38,205);CHR$(190);
  70. 350 '
  71. 355 DATA"     =====    PC-TALK III    =====
  72. 359 DATA"       Version 3.66  Level 840715
  73. 360 DATA"
  74. 361 DATA"       Communications Program for
  75. 363 DATA"       The IBM Personal Computer
  76. 365 '
  77. 370 DATA"
  78. 375 DATA" PRESS: <Home>: For Command Summary
  79. 380 DATA"       <Alt-E>:  If you cannot see
  80. 385 DATA"                 your keyboard input.
  81. 388 DATA"   <Ctrl-Home>:   Split-Screen ON/OFF
  82. 389 DATA"                  (Toggle). Use <ESC>
  83. 390 DATA"                  to erase line & the
  84. 391 DATA"                  <CR>  substitute to
  85. 392 DATA"                  send multiple lines.
  86. 393 DATA"
  87. 394 DATA"    Only for use with DOS 2.0 & up
  88. 396 DATA"
  89. 399 DATA"   (c)1983 The Headlands Press,Inc.
  90. 420 NEXT:CLOSE #2
  91. 423 B$=SPACE$(38):LOCATE 1,1:FOR I=1 TO 23:PRINT B$:NEXT:PRINT B$;'Erases logo
  92. 425 CLOSE#1:OPEN COMM$ AS #1:PRINT #1,MODMINIT$
  93. 435 '
  94. 500 '  *********  M A I N   I N P U T / O U T P U T  ***********
  95. 505 '
  96. 510 '  -- Keyboard
  97. 517 IF TMP$="" AND SP THEN XPOS=1
  98. 520 B$=INKEY$:IF B$="" THEN 560
  99. 530 IF B$=BS$ THEN CCNT=CCNT-1:IF ECH AND NOT SP THEN GOSUB 2655:IF PR THEN PR$=    PR$+B$:GOSUB 800:GOTO 555 ELSE 555 ELSE 555 ' "not sp"  fixes BSpc if ECHO      ON in splt-scrn mode. (by -Dennis Cheves-)
  100. 552 IF FKFLG AND B$="{" THEN FKFLG=0:FK=FK+1:GOTO 7575
  101. 553 IF B$=CHR$(27) AND FKFLG THEN GOSUB 7620
  102. 555 IF SP AND LEN(B$)<2 THEN 11000 ELSE IF SP AND LEN(B$)>1 THEN B2$=B$
  103. 558 PRINT#1,B$;
  104. 559 IF FCR$=D$(30) THEN SOUND SD,5:SOUND SD,1
  105. 599 '
  106. 600 '  -- Comm Port
  107. 612 IF SP AND LEN(B2$)<2 THEN LOCATE ROW,COL,0 ELSE IF SP AND LEN(B2$)>2 THEN       LOCATE FROW,FCOL,1
  108. 615 B2$="":A$=INPUT$(LOC(1),#1):IF NS=0 THEN 635
  109. 625 P=INSTR(A$,S$(I)):IF P=0 THEN 628 ELSE A$=LEFT$(A$,P-1)+R$(I)+                  RIGHT$(A$,LEN(A$)-P):GOTO 625
  110. 628 P=INSTR(A$,CHR$(0)):IF P=0 THEN 630 ELSE A$=LEFT$(A$,P-1)+                      RIGHT$(A$,LEN(A$)-P):GOTO 625
  111. 650 NEXT:GOTO 656
  112. 656 IF FCR$=D$(30) AND FKFLG THEN B$="":SOUND 100,(3*18):SOUND SD,1:FX$=INKEY$:     IF FX$=CHR$(27) THEN GOSUB 7620:FX$="":GOTO 515 ELSE IF FX$="]" THEN 656
  113. 657 IF FCR$=D$(30) AND FKFLG THEN FCR$="":FK=FK+1:GOTO 7575
  114. 658 IF INSTR(RIGHT$(A$,4),FCR$)<>0 AND FKFLG THEN FKFLG=0:FK=FK+1:GOTO 7575
  115. 659 FROW=CSRLIN:FCOL=POS(0)
  116. 660 IF SP THEN ROW=CSRLIN:COL=POS(0):LOCATE 25,XPOS,1
  117. 661 IF PR THEN PR$=PR$+A$:GOSUB 800
  118. 699 '
  119. 700 '  -- Check Status
  120. 703 IF TMP$="" AND SP THEN XPOS=1:LOCATE 25,XPOS,1  'to corr psbl csr pos err
  121. 704 IF FEX THEN FEX=0:GOSUB 2800
  122. 799 '
  123. 800 '  -- Printer buffer
  124. 825 '
  125. 1000 '   *****  ALT-KEY INPUT  *****
  126. 1005 '
  127. 1080 '
  128. 1200 '   *****  ALT-KEY DISPLAY  *****
  129. 1205 '
  130. 1500 '  **********  E X T E N D E D   C O D E S  **********
  131. 1505 '
  132. 1516 '  -- Reserved for IBM 3101 Emulation (PCTCMW.MRG) lines 1517-18-19
  133. 1517 '
  134. 1518 '
  135. 1519 '  -- Cursor up-dn/Home/Receive/View/Transmit
  136. 1530 IF EX=71 THEN 2000                      'Home = Commands
  137. 1535 IF EX=19 OR EX=81 THEN EX=19:GOTO 3000  'Alt-R,PgDn = Receive
  138. 1540 IF EX=47 THEN 3400                      'Alt-V = View
  139. 1545 IF EX=20 OR EX=73 THEN EX=20:GOTO 3200  'Alt-T,PgUp = Transmit
  140. 1548 '
  141. 1549 '  -- Parms/Dialing/Function key setting
  142. 1550 IF EX=25 THEN 5000  'Alt-P = Com Parms
  143. 1555 IF EX=32 THEN 6000  'Alt-D = Dial Directory
  144. 1560 IF EX=36 OR EX=37 THEN 7000  'Alt-J or K = F-Key Setting
  145. 1564 '
  146. 1565 '  -- Function-Keys/Alt-Keys
  147. 1570 IF EX>=59 AND EX<=68 THEN FK$=K$(EX-58):GOTO 7475   'F1-F10
  148. 1575 IF EX>=104 AND EX<=113 THEN FK$=K$(EX-93):GOTO 7475 'ALT-F1/F10
  149. 1580 IF EX>=84 AND EX<=103 THEN FK$=K$(EX-63):GOTO 7475  'CTL & SHFT-F1/F10
  150. 1585 IF EX>=120 AND EX<=129 THEN FK$=ALT$(EX-119):GOTO 7475 'ALT-1/0
  151. 1590 IF EX=15 THEN:BEEP:LOCATE 25,1:PRINT"  set Alt-(1-0):  ";CHR$(181);:ALTSET=     -1:GOTO 1000  'Shft-TB used instead of Alt-= to avoid Prokey. Level # now       in start-up screen -- Jim Gainsley
  152. 1594 '
  153. 1595 '  -- Echo/Message/Print
  154. 1614 '
  155. 1615 '  -- Elapsed time/Redial/Screendump/Defaults/Exit
  156. 1644 '
  157. 1645 '  -- Logged drive/Delete/Clearscreen/Width alarm/Menu/Break
  158. 1660 IF EX=46 THEN IF NOT SP THEN PRINT CHR$(12):GOSUB 2800:GOTO 515 ELSE CLS:       LOCATE 25,1,1:PRINT TMP$;:XPOS=LEN(TMP$)+1:ROW=1:COL=1:FROW=1:FCOL=1:GOTO       515
  159. 1675 '  (Shft-Tab (EX=15) now used for Alt-1/0 Temp Keys)
  160. 1681 '  -- More Extended Codes can go here (see p.G-6 IBM BASIC manual)
  161. 1682 IF EX=119 THEN 10000      'Ctrl-Home=Split-Screen
  162. 1684 ' Resvd for IBM 3101 Emul. per PCTCMW.  Call is to EX=24 (Alt-O)
  163. 1685 IF EX=35 THEN GOTO 1850   'Alt-H:Hangup After Connect (Hayes mode)
  164. 1691 '  -- CHDIR/Set Alt-1-0/Save Alt-1-0/Set Alt-1/0
  165. 1692 IF EX=34 THEN GOTO 11100      'Alt-G = Change sub-Directory
  166. 1693 IF EX=23 THEN GOTO 11130      'Alt-I = Set Alt-1/0 from a File
  167. 1694 IF EX=22 THEN GOTO 11160      'Alt-U = Save Alt-1/0 to File
  168. 1699 GOTO 515 'DON'T remove this line! (failsafe to return to terminal)
  169. 1847 '
  170. 1848 '   *****  HANGUP AFTER CONNECT (Hayes) -- Jim Gainsley (612)338-6124
  171. 1849 '
  172. 1850 IF NOT EOF(1) THEN Q$=INPUT$(LOC(1),#1):Q$="" ELSE Q$=""  'Purge buffer
  173. 1855 SOUND 900,20:SOUND SD,1:PRINT #1,"+++";:SOUND SD,30:SOUND SD,1
  174. 1860 IF LOC(1)>0 THEN Q$=INPUT$(LOC(1),1) ELSE GOTO 1890
  175. 1865 IF INSTR(Q$,"OK")<>0 THEN Q$="":GOTO 1870 ELSE GOTO 1890
  176. 1870 PRINT #1,"ATH0":SOUND 700,30:SOUND SD,1:Q1=0
  177. 1875 IF LOC(1)>0 THEN Q$=INPUT$(LOC(1),1)
  178. 1880 IF INSTR(Q$,"OK")<>0 OR INSTR(Q$,"NO CARRIER")<>0 THEN Q$="":GOTO 1895          ELSE PRINT"2nd PHASE FAILURE  . . ."
  179. 1885 IF Q1<4 AND INSTR(Q$,"NO CARRIER")=0 GOTO 1870
  180. 1890 Q1=Q1+1: IF INSTR(Q$,"NO CARRIER")<>0 GOTO 1895 ELSE IF Q1<4 THEN PRINT         "1rst PHASE FAILURE . . .  I'M RETRYING . . .":GOTO 1850 ELSE GOSUB 1900
  181. 1895 Q1=0:CLOSE#1:OPEN COMM$ AS #1:SOUND 500,1:SOUND SD,1:SOUND 500,1:PRINT:         PRINT GO$:GOTO 515
  182. 1900 COLOR HI,BG:PRINT "I HAVEN'T RECEIVED HANGUP VERIFICATION AFTER 4 TRIES":       COLOR FG,BG:PRINT"Check Modem CD lite.  If lit, try ALT-H again.":RETURN
  183. 1999 '
  184. 2000 '    *****  COMMAND SUMMARY  *****
  185. 2005 '
  186. 2015 LOCATE 2,39:PRINT VL$;"  ===PC-TALK III  COMMAND SUMMARY===  ";VL$
  187. 2035 LOCATE 24,39:PRINT CHR$(212)+STRING$(38,205)+CHR$(190);
  188. 2050 DATA" PrtSc Print Screen Contents
  189. 2055 DATA" ^PrtSc Continuous Printout (^PgUp)
  190. 2060 DATA" XMODEM '=x'  Pacing '=p'  Binary '=b'
  191. 2065 DATA" Shft-TAB  Set/Clear Temp Alt Keys
  192. 2070 DATA" Alt-C  Clearscreen   Alt-D  Dial Nmbr
  193. 2075 DATA" Alt-E  Echo Toggle   Alt-F  Defaults
  194. 2080 DATA" Alt-G  Get a New Subdirectory
  195. 2085 DATA" Alt-H  Hang up (Disconnect)
  196. 2090 DATA" Alt-I  Set Alt-1/0 from file
  197. 2095 DATA" Alt-K  Set/Clear Func Keys (Alt-J)
  198. 2100 DATA" Alt-L  Change Default Drive
  199. 2105 DATA" Alt-M  Messages     Alt-P  Com Parms
  200. 2110 DATA" Alt-Q  Redial Nmbr  Alt-R  Recv File
  201. 2115 DATA" Alt-S  Screendump   Alt-T  Xmit File
  202. 2120 DATA" Alt-U  Unload Alt-1/0 to file
  203. 2125 DATA" Alt-V  View a File & Show Free Space
  204. 2130 DATA" Alt-W  Set Mrgin Width Alarm
  205. 2135 DATA" Alt-X  eXit to DOS
  206. 2140 DATA" Alt-Y  Delete a File    Alt-Z  Time
  207. 2145 DATA"Ctrl-End = Send Sustained Break Signal
  208. 2450 '
  209. 2455 '
  210. 2500 '  -- Return Q$ w/ max Len QL
  211. 2554 '
  212. 2555 '  -- Convert Q$ to Uppercase
  213. 2599 '
  214. 2600 '  -- To/From Line 25
  215. 2605 MSG$=LEFT$(MSG$,77):ROW=CSRLIN:COL=POS(0):LOCATE 25,1:COLOR 31,BG:PRINT         CHR$(16);:COLOR BG,FG:PRINT MSG$+SPACE$(77-LEN(MSG$));:COLOR 31,BG:PRINT        CHR$(17);:COLOR FG,BG:LOCATE ROW,COL:RETURN
  216. 2649 '
  217. 2650 '  -- Destructive Backspace
  218. 2699 '
  219. 2700 '  -- Reopen Files Subrout
  220. 2799 '
  221. 2800 '  -- Clear Menu Line
  222. 2805 IF SP THEN RETURN ELSE ROW=CSRLIN:COL=POS(0)
  223. 2825 LOCATE 25,1:PRINT" ";:COLOR BG,FG:PRINT"^PrtSc=prnt PgUp=tran PgDn=recv V=view D=dial E=echo M=mesg X=exit HOME=Help";:COLOR FG,BG:LOCATE ROW,COL:RETURN
  224. 3000 '   *****  RECEIVE A FILE  *****
  225. 3005 '
  226. 3010 IF RC THEN RC=0:RC$="":BEEP:PRINT:PRINT"===RECEIPT OF FILE ";RCV$;              " TERMINATED===":GOSUB 3247:PRINT:GOSUB 2700:GOSUB 2800:IF MSG THEN             PRINT#1,BL$;CR$;"===FILE RECEIVED===":GOTO 515 ELSE 515
  227. 3015 RC$="":BEEP:PRINT:PRINT"===RECEIVE A FILE===":GOTO 3650
  228. 3030 MSG$=" Receiving "+RCVX$+"  (ALT-R or PgDn to Terminate)":GOSUB 2600
  229. 3107 '   *****  FIND FREE DISK SPACE WITH Alt-V  --  Jack Wright  *****
  230. 3108 '          -- Calls to DSK.OBJ
  231. 3109 '
  232. 3110 A=2:B=0:C!=0:IF DRV$="A:" OR DRV$="a:" THEN A=1
  233. 3115 IF DRV$="C:" OR DRV$="c:" THEN A=3
  234. 3132 NAME DRV$+"1" AS DRV$+"1"  'Disk must be in drive
  235. 3135 CALL DSK(A,B):C!=(C!+B)*512  'see p. 110, compiler manual
  236. 3140 PRINT DRV$;" Drive Free Space = ";C!
  237. 3145 RETURN
  238. 3200 '   *****  TRANSMIT A FILE  *****
  239. 3205 '
  240. 3210 IF TR THEN TR=0:TR$="":MSG1$="===TRANSMISSION OF FILE ":MSG2$=                  " TERMINATED===":GOSUB 3247:BEEP:PRINT:PRINT MSG1$;TRN$;MSG2$:GOSUB 2715:       GOSUB 2800:IF MSG THEN PRINT#1,CR$;MSG1$;MSG2$,BL$:GOTO 515 ELSE 515
  241. 3215 IF TR THEN TR=0:TR$="":MSG1$="===END OF FILE":MSG2$="===":BEEP:PRINT:           GOSUB 3247:PRINT MSG1$;" ";TRN$;MSG2$:GOSUB 2715:GOSUB 2800:IF MSG THEN         PRINT#1,"65529 '";MSG1$;MSG2$;BL$:GOTO 515 ELSE 515
  242. 3220 TR$="":BEEP:PRINT:PRINT"===TRANSMIT A FILE===":GOTO 3650
  243. 3230 MSG$=" Transmitting "+TRNX$+" (ALT-T or PgUp to Terminate)":IF TR$="X" THEN     MSG$=MSG$+"  # of Blocks:" ELSE IF TR$="P" THEN MSG$=MSG$+"  % Remng:" ELSE     MSG$=MSG$+"   Min. Remng:"
  244. 3247 COMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$:CLOSE#1:OPEN          COMM$ AS #1:RETURN
  245. 3400 '   *****  VIEW A FILE  *****
  246. 3401 '
  247. 3405 DRV$=DRIV$:GOSUB 3110 'Shows def. drv free space automatically on Alt-V
  248. 3410 BEEP:PRINT:PRINT"===VIEW A FILE===":GOTO 3650
  249. 3415 MSG$=" Viewing "+VEWX$+"  Press <space> to continue  (Alt-V to terminate)"      :GOSUB 2600:PRINT:PRINT:PRINT
  250. 3421 IF PR THEN LPRINT X$
  251. 3500 '   ***** FILE SPECS  *****
  252. 3505 '
  253. 3520 IF LEN(Q$)>1 THEN Q=ASC(MID$(Q$,2,1)):IF Q>=59 AND Q<=68 THEN Q$=K$(Q-58)       ELSE IF Q>=104 AND Q<=113 THEN Q$=K$(Q-93) ELSE IF Q>=84 AND Q<=103 THEN        Q$=K$(Q-63) ELSE IF Q>=120 AND Q<=129 THEN Q$=ALT$(Q-119) ELSE BEEP:GOTO        3515
  254. 3540 IF FIL$="" THEN BEEP:PRINT"===CANCELLED===":GOSUB 2800:GOTO 515
  255. 3543 IF LEFT$(FIL$,1)="/" THEN MID$(FIL$,1,1)="?"
  256. 3570 IF Q$="B" THEN TR$="B"
  257. 3585 IF TR$="B" OR TR$="X" OR RC$="X" THEN IF DTA$<>"8" THEN BEEP:PRINT              "*** Automatically converting to 8 databits for XMODEM ***"
  258. 3595 IF EX=19 THEN CLOSE#2:OPEN FIL$ FOR APPEND AS #2 ELSE CLOSE#3:OPEN FIL$         FOR INPUT AS #3
  259. 3619 '
  260. 3620 '  -- File Directory Subroutine
  261. 3640 PRINT:DRV$=LEFT$(FIL$,2):IF INSTR(FIL$,"/")=3 AND LEN(FIL$)=3 THEN              GOSUB 3110:PRINT ELSE GOSUB 3110:FILES FIL$:PRINT
  262. 3650 MSG$=" ?=Files "+DRIV$+" ?[d:]/ =Fre Spc Drv d: ?d:=Fre Spc & Files Drv d: (d=Drive) (/=?)":GOSUB 2600:GOTO 3500
  263. 3799 '
  264. 3800 '   *****  SCREENDUMP  *****
  265. 3805 '
  266. 3815 FOR I=1 TO 24:Y$="":FOR J=1 TO 79:X=SCREEN(I,J):Y$=Y$+CHR$(X):NEXT J:PRINT      #2,Y$:NEXT I:PRINT#2,STRING$(79,45);CR$;LF$;"*** PC-TALK III SCREENDUMP - "     ;DATE$;" at ";TIME$;" ***";CR$;LF$;STRING$(79,61):CLOSE#2
  267. 3900 '    *****  DELETE A FILE  *****
  268. 3905 '
  269. 4000 '   *****  TRANSMIT  *****
  270. 4005 '
  271. 4064 '
  272. 4065 '  -- XON/XOFF Subroutine
  273. 4199 '
  274. 4200 '  -- Transmit last block
  275. 4399 '
  276. 4400 '  -- Line pacing subrout
  277. 4500 '   *****  RECEIVE with XMODEM  *****
  278. 4505 '
  279. 4512 CLOSE #1:OPEN COMMPORT$+BAU$+",N,8,1"+COMMINIT$ AS 1
  280. 4539 '
  281. 4540 '  -- Check block
  282. 4629 '
  283. 4630 '  -- Terminate
  284. 4700 '   *****  TRANSMIT with XMODEM  *****
  285. 4705 '
  286. 4712 CLOSE #1:OPEN COMMPORT$+BAU$+",N,8,1"+COMMINIT$ AS 1
  287. 4749 '
  288. 4750 '  -- Hold for ACK
  289. 4809 '
  290. 4810 '  -- Build Block
  291. 4839 '
  292. 4840 '  -- Terminate
  293. 4900 '  -- XMODEM Subroutines
  294. 4901 '
  295. 4920 '  -- Hold for SOH
  296. 4959 '
  297. 4960 '  -- Test for Abort
  298. 4965 B$=INKEY$:IF LEN(B$)<2 THEN RETURN ELSE Q$=MID$(B$,2,1):IF Q$=CHR$(19) OR       Q$=CHR$(20) OR Q$=CHR$(73) OR Q$=CHR$(81) THEN ABORT=-1:RETURN ELSE RETURN
  299. 4969 '
  300. 4970 '  -- Purge Buffer
  301. 4979 '
  302. 4980 '  -- Set/Check Delay
  303. 5000 '   *****  COMM PARAMS  *****
  304. 5005 '
  305. 5050 IF Q$="X" THEN PRINT Q$:PRINT:PRINT"(present parameters still in effect)":      GOTO 5095
  306. 5095 IF MDFLG THEN RETURN ELSE PRINT GO$:GOSUB 2800:GOTO 515
  307. 5200 '   *****  NEW DEFAULTS  *****
  308. 5205 '
  309. 5230 NEXT:LOCATE ,,1:IF EXIT THEN 5280 ELSE FOR I=1 TO DFNUM:DT$(I)=D$(I):NEXT
  310. 5260 GOSUB 2500:IF Q$=CHR$(27) THEN GOSUB 2655:GOSUB 2655:ABORT=-1 ELSE IF           Q$<>"" THEN DT$(I)=Q$:IF DT$(I)=" " THEN DT$(I)=""
  311. 5270 GOSUB 5295:PRINT"*** New values ok (y/n)?";:Q$=INPUT$(1):PRINT Q$:GOSUB         2555:IF Q$="N" THEN GOSUB 5295:LOCATE 21,1:PRINT SPACE$(79);:LOCATE 21,1:       PRINT"(Default Routine Cancelled)":GOTO 5290 ELSE FOR I=1 TO DFNUM:D$(I)=   DT$(I):NEXT
  312. 5399 '
  313. 5400 '  -- Create Default File
  314. 5435 DATA Comm. port,"COM1:",Comm. init.,",CS,DS",Modem init.,,C/R subst.,},         F-Key Dly Char,~
  315. 5599 '
  316. 5600 '  -- Update Values
  317. 5799 '
  318. 5800 '  -- Default Subroutine
  319. 5815 COMM$=DCOMM$
  320. 5820 ECH=DECH:MSG=DMSG:NS=DNS:FOR J=1 TO 3:I=2*J+5:S$(J)=DS$(J):R$(J)=DR$(J):        NEXT:PC$=DPC$:RETURN
  321. 6000 '   *****  DIALING DIRECTORY  *****
  322. 6005 '
  323. 6024 '
  324. 6025 '  -- Write to Screen
  325. 6079 '
  326. 6080 '  -- Initial Choice
  327. 6085 LOCATE 21,1:PRINT"Enter Dir. #:             | or...
  328. 6199 '
  329. 6200 '  -- Dial Entry
  330. 6299 '
  331. 6300 '  -- Manual Dialing
  332. 6305 MDFLG=0:LOCATE 7,1:PRINT"Current Comm Parameters are: ";COMM$:PRINT: PRINT      "Options: 1) Use Current  2) Use Default  3) Change (1/2/3 cr=Current) ";
  333. 6306 B$=INKEY$:IF B$="" GOTO 6306 ELSE IF VAL(B$)<>1 AND VAL(B$)<>2 AND              VAL(B$)<>3 AND B$<>CHR$(13) THEN BEEP:GOTO 6306 ELSE PRINT B$
  334. 6307 IF VAL(B$)=1 OR B$=CHR$(13) THEN GOSUB 5820:MCOM$=COMM$:GOTO 6308 ELSE IF       VAL(B$)=2 THEN GOSUB 5820:MCOM$=DCOMM$:GOTO 6308 ELSE MDFLG=-1:GOSUB 5010:      MDFLG=0:MCOM$=COMM$:GOSUB 5820
  335. 6308 PRINT:PRINT"===DIAL PHONE # w/o Dial Command: (cr=Cancel) ";:QL=36:             GOSUB 2500:R$=Q$:N$="
  336. 6325 CLOSE#1:OPEN MCOM$ AS #1:PRINT#1,MODM$+DIAL$:STRT$=TIME$:PRINT:LOCATE,,1:       RETURN
  337. 6399 '
  338. 6400 '  -- Revise
  339. 6469 '
  340. 6470 '  -- Name & Number
  341. 6499 '
  342. 6500 '  -- Comm Params
  343. 6554 '
  344. 6555 '  -- Echo & Messages
  345. 6589 '
  346. 6590 '  -- Strip Characters
  347. 6649 '
  348. 6650 '  -- Pacing
  349. 6799 '
  350. 6800 '  -- Write new info
  351. 6824 '
  352. 6825 '  -- Modem$ & Service$
  353. 6849 '
  354. 6850 '  -- Clear Directory
  355. 6899 '
  356. 6900 '  -- Message Area Subroutine
  357. 7000 '   *****  FUNCTION KEY SYSTEM  *****
  358. 7005 '
  359. 7010 BEEP:IF KPG=0 THEN KPG=1
  360. 7015 CLS:LOCATE 1,18,0:PRINT CHR$(213)+STRING$(59,205)+CHR$(184)
  361. 7020 LOCATE 2,18:PRINT VL$;"     ===FUNCTION KEY DIRECTORY==="SPC(26);VL$
  362. 7025 LOCATE 3,18:PRINT VL$;SPACE$(15);:COLOR HI,BG:PRINT KPG$(KPG);:COLOR FG,BG:     PRINT" F1-10";SPACE$(34);VL$
  363. 7030 LOCATE 4,18:PRINT VL$;:COLOR BG,FG:PRINT" F-  Input String";SPACE$(42);:        COLOR FG,BG:PRINT VL$
  364. 7035 FOR I=1 TO 10:P=(KPG-1)*10+I
  365. 7040 LOCATE I+4,18,0:PRINT VL$;:PRINT USING "##";I;:PRINT"= ";
  366. 7045 K=LEN(K$(P)):IF K>55 THEN K=55
  367. 7055 NEXT J:PRINT SPACE$(55-K)+VL$+"  ";:NEXT I
  368. 7060 LOCATE 15,18,1:PRINT CHR$(198)+STRING$(59,205)+CHR$(181)
  369. 7099 '
  370. 7100 '  -- Proceed?
  371. 7105 GOSUB 7435:LOCATE 16,19,1:PRINT D$(30)" = 3"CHR$(34)" Timing Char. "VL$"PRESS:  R TO REVISE ";KPG$(KPG);                "-F ASSIGNMENTS
  372. 7110 LOCATE 17,19:PRINT"| = Char Sense Swtch"VL$"    F / B to page through directory
  373. 7115 LOCATE 18,19:PRINT"Exmpl: |? Wait for ?"VL$"        X to exit to terminal
  374. 7130 IF Q$="X" THEN CLOSE#2:GOSUB 2700:CLS:GOSUB 2800:PRINT GO$:GOTO 515
  375. 7199 '
  376. 7200 '  -- Revise
  377. 7230 GOSUB 2555:IF Q$="X" THEN CLOSE#2:GOSUB 2700:CLS:GOSUB 2800:PRINT GO$:          GOTO 515
  378. 7274 '
  379. 7275 '  -- New Input String
  380. 7297 PRINT"'|' before each wait-for or timing character. |! = Wait for !  |";D$(30);" = 3 sec delay";
  381. 7399 '
  382. 7400 '  -- Write New Info
  383. 7419 '
  384. 7420 '  -- Create Directory
  385. 7434 '
  386. 7435 '  -- Message Area Subroutine
  387. 7440 FOR I=16 TO 18:LOCATE I,18,0:PRINT VL$;SPACE$(59);VL$;"   ";:NEXT
  388. 7445 LOCATE 19,18:PRINT CHR$(212);STRING$(59,205);CHR$(190);"   ";:LOCATE ,,1:       RETURN
  389. 7465 '
  390. 7475 '  -- Function Key & Alt Key Pacing -- by Jim Gainsley, Mpls MN, June 1984
  391. 7485 '
  392. 7495 IF INSTR(FK$,FS$)=0 THEN B$=FK$:GOTO 535 ELSE B$="":FFF=0:FKFLG=-1:FCC=1:       FCR$="":FP$="":MSG$="  '{' to Send next Segment.  ']' to Continue Delay.  'Esc' to Terminate.":IF NOT SP THEN GOSUB 2600
  393. 7525 FOR FK=1 TO LEN(FK$):FP$=MID$(FK$,FK,1)
  394. 7535 IF FP$<>D$(30) AND FP$<>FS$ AND FP$<>FCR$ THEN B$=B$+FP$:GOTO 7605
  395. 7545 IF NOT FFF AND FP$=FS$ THEN FCC=INSTR(FK$,FP$):FFF=-1
  396. 7555 IF FP$=FS$ THEN FCR$=MID$(FK$,(INSTR(FCC,FK$,FP$)+1),1):FCC=                    INSTR(FCC+1,FK$,FP$):FKFLG=-1 ' Sets FCR$ to wait-for character
  397. 7559 '
  398. 7560 '  -- Go To Main I/O & Send String Packet
  399. 7565 LOCATE ,,1:IF FCR$=D$(30) AND B$="" THEN GOTO 656 ELSE GOTO 535
  400. 7573 '
  401. 7574 '  -- Back Here for More
  402. 7575 B$=""
  403. 7605 NEXT:FEX=-1:FKFLG=0:SOUND 600,2:SOUND SD,1:SOUND 400,2:IF SP=0 THEN ROW=        CSRLIN:COL=POS(0):GOSUB 2820:GOTO 535 ELSE GOTO 535
  404. 7618 '
  405. 7619 '  -- Terminated (Aborted)
  406. 7620 B$="":FKFLG=0:FCC=1:FP$="":COLOR HI,BG:LOCATE FROW,FCOL:PRINT"TERMINATED":      COLOR FG,BG:SOUND 800,3:SOUND 1400,2:IF SP=0 THEN GOSUB 2800:RETURN ELSE        RETURN
  407. 7999 '
  408. 8000 '   *****  REDIAL -- by Jim Gainsley, Mpls MN, July 1984  (612)338-6124
  409. 8005 '
  410. 8010 COMA=0:Q1DELAY=QDELAY 'COMA--To recognize pauses if used in DIAL$
  411. 8015 FOR I=1 TO LEN(DIAL$):IF MID$(DIAL$,I,1)="," THEN COMA=COMA+38
  412. 8020 NEXT:IX=0:CLS:V$=TIME$:LOCATE 18,4,0:PRINT"To change disconnect delay time press ";:COLOR HI,BG:PRINT"]";:COLOR FG,BG:PRINT" after ' DIALING: ' appears above, or";
  413. 8025 PRINT"   you may select 33%, 50% or 66% of the current delay by pressing 1, 2, or 3.";:PRINT"   (Press ESC to cancel delay selected by 1/2/3.)":LOCATE 1,1
  414. 8030 MSG$="  Press:  R to RECYCLE, SPACE BAR to TERMINATE, ALT-D for DIALING DIRECTORY. ":GOSUB 2600:LOCATE 2,54:PRINT"REDIAL STARTED AT: ";:COLOR HI,BG:            PRINT V$;:COLOR FG,BG:LOCATE 1,1
  415. 8035 Q1$="":Q$="":PRINT"  ===REDIALING ";N$;:LOCATE 1,45:PRINT                       "Time at Start of This Pass: ";:COLOR HI,BG:PRINT TIME$:COLOR FG,BG:            LOCATE 2,1:PRINT#1,MODM$+DIAL$:ROW=CSRLIN:COL=POS(0)
  416. 8040 SOUND SD,(12000/VAL(BAU$))+COMA:SOUND SD,1:I=0:IX=IX+1:AFLG=0
  417. 8045 WHILE I<>Q1DELAY
  418. 8050  LOCATE 22,4:PRINT"THIS IS TRY #: ";IX;"  ELAPSED TIME THIS PASS ";I;
  419. 8055  B1$=INKEY$:IF B1$="R" OR B1$="r" GOTO 8125
  420. 8060  IF B1$="]" GOTO 8180
  421. 8065  IF B1$="1" THEN Q1DELAY=Q1DELAY*.33:GOSUB 8197 ELSE IF B1$="2" THEN             Q1DELAY=Q1DELAY*.5:GOSUB 8197 ELSE IF B1$="3" THEN Q1DELAY=Q1DELAY*.66:         GOSUB 8197 ELSE IF B1$=CHR$(27) THEN Q1DELAY=QDELAY:GOSUB 8197
  422. 8070  IF Q1DELAY <=7 THEN Q1DELAY=7:GOSUB 8197
  423. 8075  IF B1$=" " OR B1$=CHR$(0)+CHR$(32) THEN 8165
  424. 8080  IF LOC(1)>0 THEN Q$=INPUT$(LOC(1),1):Q1$=Q1$+Q$ ELSE 8090 'See Ln 9055
  425. 8085  IF INSTR(Q1$,MODM$+DIAL$)<>0 AND AFLG=0 THEN LOCATE ROW,COL:PRINT            "  ** DIALING: ";MODM$+DIAL$:PRINT"  ** COM PARAMS: ";MID$(COMM$,6,10):         PRINT"  ** DISCONNECT DELAY PERIOD IS: "Q1DELAY:AFLG=1:ROW=CSRLIN:COL=POS(0)
  426. 8090  I=I+1
  427. 8095  IF INSTR(Q1$,CONNECT$)<>0 GOTO 8140
  428. 8100  IF INSTR(Q1$,"BUSY")<>0 OR INSTR(Q1$,"NO CARRIER")<>0 GOTO 8135
  429. 8105  SOUND SD,18.5:SOUND SD,1 'Provides elapsed time since dial completed
  430. 8110 WEND
  431. 8114 '
  432. 8115 '  -- Delay Time has Expired
  433. 8120 LOCATE ROW,COL:COLOR HI,BG:PRINT"  ** DELAY PERIOD EXPIRED **";:COLOR 7,BG
  434. 8125 PRINT#1,"A":SOUND SD,30:SOUND SD,1:GOSUB 8195:CLOSE#1:OPEN COMM$ AS #1:         GOTO 8030
  435. 8129 '
  436. 8130 '  -- Busy or No Carrier
  437. 8135 LOCATE ROW,COL:COLOR HI,BG:PRINT"  *** LINE BUSY OR NO CARRIER ***":            COLOR FG,BG:SOUND SD,26:SOUND SD,1:GOSUB 8195:GOTO 8030
  438. 8139 '
  439. 8140 '  -- Connected
  440. 8145 STRT$=TIME$:MSG$=" REMOTE COMPUTER ON LINE *** HIT ANY KEY TO PROCEED ***"      :GOSUB 2600
  441. 8150 LOCATE 12,15:COLOR 31,BG:PRINT"  <<<  CONNECTED WITH "N$"  >>>":                COLOR FG,BG
  442. 8155 IF INKEY$="" THEN SOUND 600,4:SOUND 900,4:GOTO 8155 ELSE CLS:GOSUB 2800:        LOCATE ,,1:GOTO 515
  443. 8159 '
  444. 8160 '  -- Redial Terminate
  445. 8165 PRINT#1,"A";:SOUND 700,30:SOUND SD,1:IF B1$=CHR$(0)+CHR$(32) THEN 6000
  446. 8170 CLS:BEEP:PRINT"===REDIAL TERMINATED...Back in Terminal Mode ===":PRINT GO$:     GOSUB 2800:LOCATE ,,1:GOTO 515
  447. 8174 '
  448. 8175 '  -- Set New Disconnect Delay Time
  449. 8180 LOCATE 13,1:INPUT"GIVE NEW DELAY IN SECONDS (10 sec. minimum  cr=default)";     Q1DELAY
  450. 8185 IF Q1DELAY=0 THEN Q1DELAY=QDELAY ELSE IF Q1DELAY<10 THEN Q1DELAY=10
  451. 8190 GOSUB 8197:LOCATE 13,1:PRINT SPACE$(78);:GOTO 8080
  452. 8195 LOCATE 2,1:FOR I=1 TO 4:PRINT SPACE$(40):NEXT:LOCATE 1,1:RETURN
  453. 8197 XROW=CSRLIN:XCOL=POS(0):LOCATE 20,53:COLOR HI,BG:PRINT"NEW DELAY IS: "          Q1DELAY:COLOR FG,BG:LOCATE XROW,XCOL:RETURN
  454. 8199 '
  455. 8200 '   *****  ELAPSED TIME  *****
  456. 8205 '
  457. 8900 '   *****  ERROR SUBROUTINE  *****
  458. 8905 '
  459. 8915 PRINT:PRINT:PRINT"(returning to DOS)":SOUND SD,1:SOUND SD,1:SYSTEM
  460. 8920 '
  461. 8960 PRINT"===File NOT FOUND or Invalid Filename===":RETURN
  462. 8999 '
  463. 9000 '   *********  E R R O R   T R A P S  **********
  464. 9001 '
  465. 9002 IF ERL=3132 AND ERR=71 THEN PRINT"DISK NOT READY!":RESUME 3145
  466. 9003 IF ERL=3132 THEN RESUME 3135
  467. 9010 IF ERL=215 THEN RESUME 5405
  468. 9015 IF ERL=225 THEN RESUME 245
  469. 9030 IF ERR=27 THEN BEEP:MGS$="CHECK PRINTER":GOSUB 8925:PR=0:IF ERL=1610 THEN       RESUME 515 ELSE RESUME 820
  470. 9035 IF ERL=5280 THEN BEEP:GOSUB 5295:PRINT TAB(31)                                  "*** Invalid communications parameters. Try again.";:EXIT=0:RESUME 5215
  471. 9055 IF ERR=57 THEN MSG$="":GOSUB 8925:IF RC$="X" THEN RESUME 4525 ELSE IF           TC$="X" THEN RESUME 4725 ELSE IF ERL=8080 THEN RESUME 8085 ELSE RESUME 515
  472. 9120 IF (ERR=52 OR ERR=53 OR ERR=67) AND ERL=11137 THEN BEEP:GOSUB 8960              :RESUME 11130
  473. 9125 IF (ERR=52 OR ERR=53 OR ERR=67) AND ERL=11167 THEN BEEP:GOSUB 8960              :RESUME 11160
  474. 9900 '  -- If Not Trapped
  475. 9905 BEEP:MSG$=" Sorry, NON-RECOVERABLE ERROR "+STR$(ERR)+" at line"+ STR$(ERL):     GOSUB 2600:IF NOT ERR=5 THEN CLOSE:ON ERROR GOTO 0 ELSE ON ERROR GOTO 0
  476. 9946 '
  477. 9999 ' (Level # now part of Start-up screen data)
  478. 10000 '
  479. 10001 '   *****  SPLIT-SCREEN OPERATION --  By Wes Meier  *****
  480. 10002 '
  481. 10003 IF SP THEN SP=0:TMP$="":LOCATE ROW,COL,1:PRINT:PRINT ELSE 10010
  482. 10004 PRINT"===Split Screen Operation Off":BEEP:PRINT:ROW=CSRLIN:COL=POS(0)
  483. 10005 LOCATE 25,1,0:PRINT CLIN$:GOSUB 2820:LOCATE ROW,COL,1:GOTO 515
  484. 10010 SP=-1:BEEP:PRINT:PRINT"===Split Screen Operation On":ROW=CSRLIN
  485. 10012 COL=POS(0):FROW=CSRLIN:FCOL=POS(0):LOCATE 25,1:PRINT CLIN$:LOCATE 25,1,1:       GOTO 515
  486. 10900 '
  487. 10901 '  -- Lines 11000-11010 mod to provide mult. line sends, using the <cr>               sub. chr, in splt-scrn -Dennis Cheves-(904)376-0718
  488. 11000 IF B$=CR$ THEN RETPOS=INSTR(TMP$,XCR$):IF RETPOS=0 THEN LOCATE 25,1,0:          PRINT CLIN$;:B$=TMP$:TMP$="":GOTO 11010 ELSE IF LEN(TMP$)>1 THEN GOTO           11005 ELSE TMP$="":XPOS=1:LOCATE 25,XPOS,1:GOTO 560 ELSE GOTO 11020
  489. 11005 B$=LEFT$(TMP$,RETPOS-1):TMP$=RIGHT$(TMP$,LEN(TMP$)-RETPOS):LOCATE 25,1,0:       PRINT CLIN$;:XPOS=LEN(TMP$)+1:LOCATE 25,1,0:PRINT TMP$;:GOTO 11010
  490. 11010 B$=B$+CR$:GOTO 558
  491. 11020 IF B$=CHR$(27) THEN TMP$="":LOCATE 25,1,0:PRINT CLIN$;:XPOS=1 ELSE 11030
  492. 11022 LOCATE 25,XPOS,1:GOTO 560
  493. 11030 IF B$=BS$ AND XPOS>1 THEN TMP$=LEFT$(TMP$,LEN(TMP$)-1) ELSE 11040
  494. 11032 XPOS=XPOS-1:GOSUB 2655:LOCATE 25,XPOS,1:GOTO 560
  495. 11040 IF B$=BS$ AND XPOS=1 THEN B$="":GOTO 560  'B$="" added to prevent compiler      problem when attempt to bckspc beyond position 1 (-Gainsley-)
  496. 11050 LOCATE 25,XPOS,1:PRINT B$;:TMP$=TMP$+B$:XPOS=XPOS+1
  497. 11055 IF XPOS>79 THEN XPOS=1
  498. 11060 GOTO 560
  499. 11097 '
  500. 11098 '   *****  CD SUBROUTINE FOR ALT-G GET A NEW DIRECTORY -- John Chapmen
  501. 11099 '
  502. 11100 BEEP:PRINT "=== SPECIFY DIRECTORY ==="
  503. 11101 GOTO 11182
  504. 11102 GOSUB 11180
  505. 11112 QL=63:PRINT "New  Directory  Name:"; 
  506. 11114 GOSUB 2500:PRINT:IF Q$="" THEN GOTO 11124
  507. 11116 IF LEFT$(Q$,1)<>"\" THEN PRINT "Directory Name must begin with \":              GOTO 11112
  508. 11118 NEWDIR$=DRIV$+Q$+CHR$(0):RETCD%=0 :CALL CHDIR(NEWDIR$,RETCD%)
  509. 11120 IF RETCD%=0 THEN CURDIR$=NEWDIR$:NEWDIR$="":GOSUB 11180:GOTO 515
  510. 11122 IF RETCD%=3 THEN BEEP:PRINT "PATH/DIRECTORY NOT FOUND":GOTO 11124
  511. 11123 PRINT "Invalid Return Code from CHDIR = ";RETCD%:GOTO 11124
  512. 11124 BEEP:PRINT "===CANCELLED===":GOTO 515
  513. 11127 '
  514. 11128 '   *****  ALT-I SUBROUTINE: LOAD KEYS 1-0 FROM FILE -- By John Chapmen
  515. 11129 '
  516. 11130 IF RC OR TR GOTO 11196
  517. 11132 BEEP:PRINT "SPECIFY FILENAME TO LOAD FROM === : ":GOSUB 11195
  518. 11136 ALTFILE$=Q$:CLS
  519. 11137 CLOSE #3:OPEN ALTFILE$ FOR INPUT AS #3
  520. 11138 FOR IA=1 TO 10:
  521. 11140 INPUT #3,ALTSTR$:PRINT "Alt-";IA;" = ";ALTSTR$
  522. 11142 IAX = INSTR(ALTSTR$,XCR$): IF IAX = 0 THEN 11143 ELSE MID$(ALTSTR$,IAX,1)       = CHR$(13): GOTO 11142
  523. 11143 IF LEN(ALTSTR$)>50 THEN ALT$(IA)=LEFT$(ALTSTR$,50) ELSE ALT$(IA) =ALTSTR$
  524. 11144 NEXT
  525. 11145 CLOSE #3
  526. 11146 BEEP:PRINT "Alt-1 THRU Alt-0 LOADED FROM:";ALTFILE$:GOTO 515
  527. 11157 '
  528. 11158 '   *****  ALT-U SUBROUTINE (UNLOAD Alt-1/0 TO FILEMAME) -- John Chapmen
  529. 11159 '
  530. 11160 IF RC OR TR GOTO 11196
  531. 11162 BEEP:PRINT "SPECIFY FILENAME TO SAVE INTO === : ":GOSUB 11195
  532. 11166 ALTFILE$=Q$:CLS
  533. 11167 CLOSE #3:OPEN ALTFILE$ FOR OUTPUT AS #3
  534. 11168 FOR IA=1 TO 10:
  535. 11170 ALTSTR$ = ALT$(IA)
  536. 11172 IAX = INSTR(ALTSTR$,CR$): IF IAX = 0 THEN 11173 ELSE MID$(ALTSTR$,IAX,1)        = XCR$: GOTO 11172
  537. 11173 PRINT "Alt-";IA;" = ";ALTSTR$:
  538. 11175 PRINT #3,CHR$(34);ALTSTR$;CHR$(34)
  539. 11176 NEXT
  540. 11177 CLOSE #3
  541. 11178 BEEP:PRINT "Alt-1 THRU Alt-0 SAVED INTO:";ALTFILE$:GOTO 515
  542. 11179 '  -- Service Subroutines for SUBDIRECTORY SUPPORT -- John Chapmen
  543. 11180 IF CURDIR$<>"" THEN PRINT:PRINT"Current Directory is: [";DRIV$;"]";             MID$(CURDIR$,INSTR(CURDIR$,"\"))
  544. 11181 RETURN
  545. 11182 CURDIR$="":NEWDIR$="                                "
  546. 11183 NEWDIR$=   NEWDIR$+"                                "+CHR$(0)
  547. 11185 CALL GETDIR(NEWDIR$,DRIV$,RETCD%)
  548. 11186 IF RETCD%<>0 THEN PRINT "Return Code from GETDIR = ";RETCD%: GOTO 11188
  549. 11187 IA=INSTR(NEWDIR$,CHR$(0)):CURDIR$="\"+LEFT$(NEWDIR$,IA-1)
  550. 11188 GOTO 11102
  551. 11195 QL=12:GOSUB 2500:PRINT:IF Q$="" THEN GOTO 11124 ELSE RETURN
  552. 11196 BEEP:PRINT"I can't SAVE or LOAD ALT-1/0 Keys during File Operations":GOTO       11124
  553. 11199 '
  554. 11200 GOTO 515 ' FAILSAFE EXIT
  555.